library(plotly)
alfa = 15 * pi/180
Rotar15 = matrix(
c(cos(alfa), -sin(alfa), 0,
sin(alfa), cos(alfa), 0,
0, 0, 1),
nrow = 3,
ncol = 3,
byrow = TRUE
)
Estirar = matrix(
c(4, 0, 0,
0, 4, 0,
0, 0, 1),
nrow = 3,
ncol = 3,
byrow = TRUE
)
calcularPuntos <- function(xy, transformaciones) {
cuantos <- length(xy)
x = xy[seq(1, cuantos, by = 2)] #Toma cada dos valores el primero (qe seria la x)
y = xy[seq(2, cuantos, by = 2)] #Lo mismo pero con el segundo valor, qe es la y
frame = rep(1, each = cuantos/2) #Los define como del primer frame
xyAnterior = xy #Cada transformacion empieza en los xy qe dejo la anterior
for (it in seq(1, length(transformaciones))) {
rxy = c()
for (i in seq(1, cuantos, by =2)) {
p <- xyAnterior[i:(i+1)] #P tiene el i-esimo xy anterior
r <- transformaciones[it][[1]] %*% append(p, 1) #Le aplico esta transformacion
rxy <- append(rxy, r[1:2]) #Lo guardo para la proxima transformacion
x <- append(x, r[1]) #Lo agrego para armar el dataframe de animar
y <- append(y, r[2])
frame <- append(frame, it+1)
}
xyAnterior <- rxy
}
df <- data.frame(
x,
y,
frame
)
df
}
transformarYDibujar <- function(xy, transformaciones) {
df <- calcularPuntos(xy, transformaciones)
p <- ggplot(df) +
geom_polygon(aes(frame = frame, x= x, y=y), color = "red")
ggplotly(p, width = 600, height = 600) %>%
animation_opts(1000)
}
transformaciones1 = list(Rotar15, Rotar15, Rotar15, Estirar)
xycuadrado = c(1, 1, 1, 2, 4, 2, 4, 1) #x0, y0, x1, y1, x2, y2
transformarYDibujar(xycuadrado, transformaciones1)
calcularEstrella <- function(n, r=1, rIntPct=50, alfa0grados=0, fill="blue") {#Me pasas la distancia de los puntos al centro; qe tanto qeres qe se hunda (en porcentaje de r) y la cantidad de puntos qe qeres qe dibuje
alfa0 <- alfa0grados*pi/180
x <- c() #Aca voy a ir guardando los valores de x e y
y <- c()
if (n >= 3) { #Revisa qe la estrella tenga tres o mas puntos
rint <- r-(rIntPct*r/100) #Calculo con el porcentaje de hundimiento la distancia de los puntos internos al centro
alfa <- 2*pi/n #Calcula la apertura entre dos extremidades
for (i in 0:(n-1)) { #Puntos externos
ex <- r*cos(i*alfa+alfa0) #Calcula la posicion de los puntos extremos
ey <- r*sin(i*alfa+alfa0)
x <- append(x, ex)
y <- append(y, ey)
#Puntos internos
ix <- rint*cos((i+1/2)*alfa+alfa0) #Calcula la posicion de los puntos internos
iy <- rint*sin((i+1/2)*alfa+alfa0)
x <- append(x, ix)
y <- append(y, iy)
}
} else {
print("ERROR: No, no, no. Las estrellas tienen tres o mas puntos")
}
dfEst <- data.frame(
x,
y,
color = rep(fill, length(x))
)
}
dibujarEstrella <- function(n, r=1, rIntPct=50, alfa0=0, fill="blue") {
dfEst <- calcularEstrella(n, r, rIntPct, alfa0, fill)
dibujo <- ggplot(dfEst) +
geom_polygon(aes(x= x, y=y, fill = color))
ggplotly(dibujo, width = 600, height = 600) %>%
animation_opts(1000)
}
dibujarEstrella(4, alfa0=45, fill=3.1)
estrella1df <- calcularEstrella(16, fill=3.0)
estrella1xy <- c()
for (i in 1:length(estrella1df$x)) {
estrella1xy <- append(estrella1xy, as.numeric(estrella1df[i, 1:2]))
}
transformarYDibujar(estrella1xy, transformaciones1)
Ignoring unknown aesthetics: frame
LS0tDQp0aXRsZTogIlIgTm90ZWJvb2siDQpvdXRwdXQ6IGh0bWxfbm90ZWJvb2sNCi0tLQ0KYGBge3J9DQpsaWJyYXJ5KHBsb3RseSkNCmBgYA0KDQpgYGB7cn0NCmFsZmEgPSAxNSAqIHBpLzE4MA0KDQpSb3RhcjE1ID0gbWF0cml4KA0KICBjKGNvcyhhbGZhKSwgLXNpbihhbGZhKSwgMCwNCiAgICBzaW4oYWxmYSksIGNvcyhhbGZhKSwgMCwNCiAgICAwLCAwLCAxKSwNCiAgbnJvdyA9IDMsDQogIG5jb2wgPSAzLA0KICBieXJvdyA9IFRSVUUNCikNCmBgYA0KDQpgYGB7cn0NCkVzdGlyYXIgPSBtYXRyaXgoDQogIGMoNCwgMCwgMCwNCiAgICAwLCA0LCAwLA0KICAgIDAsIDAsIDEpLA0KICBucm93ID0gMywNCiAgbmNvbCA9IDMsDQogIGJ5cm93ID0gVFJVRQ0KKQ0KYGBgDQoNCmBgYHtyfQ0KY2FsY3VsYXJQdW50b3MgPC0gZnVuY3Rpb24oeHksIHRyYW5zZm9ybWFjaW9uZXMpIHsNCiAgY3VhbnRvcyA8LSBsZW5ndGgoeHkpDQogIHggPSB4eVtzZXEoMSwgY3VhbnRvcywgYnkgPSAyKV0gI1RvbWEgY2FkYSBkb3MgdmFsb3JlcyBlbCBwcmltZXJvIChxZSBzZXJpYSBsYSB4KQ0KICB5ID0geHlbc2VxKDIsIGN1YW50b3MsIGJ5ID0gMildICNMbyBtaXNtbyBwZXJvIGNvbiBlbCBzZWd1bmRvIHZhbG9yLCBxZSBlcyBsYSB5DQogIGZyYW1lID0gcmVwKDEsIGVhY2ggPSBjdWFudG9zLzIpICNMb3MgZGVmaW5lIGNvbW8gZGVsIHByaW1lciBmcmFtZQ0KICANCiAgeHlBbnRlcmlvciA9IHh5ICNDYWRhIHRyYW5zZm9ybWFjaW9uIGVtcGllemEgZW4gbG9zIHh5IHFlIGRlam8gbGEgYW50ZXJpb3INCiAgZm9yIChpdCBpbiBzZXEoMSwgbGVuZ3RoKHRyYW5zZm9ybWFjaW9uZXMpKSkgew0KICAgIHJ4eSA9IGMoKQ0KICAgIGZvciAoaSBpbiBzZXEoMSwgY3VhbnRvcywgYnkgPTIpKSB7DQogICAgICBwIDwtIHh5QW50ZXJpb3JbaTooaSsxKV0gI1AgdGllbmUgZWwgaS1lc2ltbyB4eSBhbnRlcmlvcg0KICAgICAgciA8LSB0cmFuc2Zvcm1hY2lvbmVzW2l0XVtbMV1dICUqJSBhcHBlbmQocCwgMSkgI0xlIGFwbGljbyBlc3RhIHRyYW5zZm9ybWFjaW9uDQogICAgICANCiAgICAgIHJ4eSA8LSBhcHBlbmQocnh5LCByWzE6Ml0pICNMbyBndWFyZG8gcGFyYSBsYSBwcm94aW1hIHRyYW5zZm9ybWFjaW9uDQogICAgICANCiAgICAgIHggPC0gYXBwZW5kKHgsIHJbMV0pICNMbyBhZ3JlZ28gcGFyYSBhcm1hciBlbCBkYXRhZnJhbWUgZGUgYW5pbWFyDQogICAgICB5IDwtIGFwcGVuZCh5LCByWzJdKQ0KICAgICAgZnJhbWUgPC0gYXBwZW5kKGZyYW1lLCBpdCsxKQ0KICAgIH0NCiAgICB4eUFudGVyaW9yIDwtIHJ4eQ0KICB9DQogIGRmIDwtIGRhdGEuZnJhbWUoDQogIHgsDQogIHksDQogIGZyYW1lDQogICkNCiAgZGYNCn0NCg0KdHJhbnNmb3JtYXJZRGlidWphciA8LSBmdW5jdGlvbih4eSwgdHJhbnNmb3JtYWNpb25lcykgew0KICBkZiA8LSBjYWxjdWxhclB1bnRvcyh4eSwgdHJhbnNmb3JtYWNpb25lcykNCiAgcCA8LSBnZ3Bsb3QoZGYpICsNCiAgICBnZW9tX3BvbHlnb24oYWVzKGZyYW1lID0gZnJhbWUsIHg9IHgsIHk9eSksIGNvbG9yID0gInJlZCIpDQogICANCiAgZ2dwbG90bHkocCwgd2lkdGggPSA2MDAsIGhlaWdodCA9IDYwMCkgJT4lDQogICAgYW5pbWF0aW9uX29wdHMoMTAwMCkNCn0NCmBgYA0KDQpgYGB7cn0NCnRyYW5zZm9ybWFjaW9uZXMxID0gbGlzdChSb3RhcjE1LCBSb3RhcjE1LCBSb3RhcjE1LCBFc3RpcmFyKQ0KeHljdWFkcmFkbyA9IGMoMSwgMSwgMSwgMiwgNCwgMiwgNCwgMSkgI3gwLCB5MCwgeDEsIHkxLCB4MiwgeTINCg0KdHJhbnNmb3JtYXJZRGlidWphcih4eWN1YWRyYWRvLCB0cmFuc2Zvcm1hY2lvbmVzMSkNCmBgYA0KDQpgYGB7cn0NCmNhbGN1bGFyRXN0cmVsbGEgPC0gZnVuY3Rpb24obiwgcj0xLCBySW50UGN0PTUwLCBhbGZhMGdyYWRvcz0wLCBmaWxsPSJibHVlIikgeyNNZSBwYXNhcyBsYSBkaXN0YW5jaWEgZGUgbG9zIHB1bnRvcyBhbCBjZW50cm87IHFlIHRhbnRvIHFlcmVzIHFlIHNlIGh1bmRhIChlbiBwb3JjZW50YWplIGRlIHIpIHkgbGEgY2FudGlkYWQgZGUgcHVudG9zIHFlIHFlcmVzIHFlIGRpYnVqZQ0KICBhbGZhMCA8LSBhbGZhMGdyYWRvcypwaS8xODANCiAgDQogIHggPC0gYygpICNBY2Egdm95IGEgaXIgZ3VhcmRhbmRvIGxvcyB2YWxvcmVzIGRlIHggZSB5DQogIHkgPC0gYygpDQoNCiAgaWYgKG4gPj0gMykgeyAjUmV2aXNhIHFlIGxhIGVzdHJlbGxhIHRlbmdhIHRyZXMgbyBtYXMgcHVudG9zDQogICAgcmludCA8LSByLShySW50UGN0KnIvMTAwKSAjQ2FsY3VsbyBjb24gZWwgcG9yY2VudGFqZSBkZSBodW5kaW1pZW50byBsYSBkaXN0YW5jaWEgZGUgbG9zIHB1bnRvcyBpbnRlcm5vcyBhbCBjZW50cm8NCiAgICBhbGZhIDwtIDIqcGkvbiAjQ2FsY3VsYSBsYSBhcGVydHVyYSBlbnRyZSBkb3MgZXh0cmVtaWRhZGVzDQoNCiAgICBmb3IgKGkgaW4gMDoobi0xKSkgeyAjUHVudG9zIGV4dGVybm9zDQogICAgICBleCA8LSByKmNvcyhpKmFsZmErYWxmYTApICNDYWxjdWxhIGxhIHBvc2ljaW9uIGRlIGxvcyBwdW50b3MgZXh0cmVtb3MNCiAgICAgIGV5IDwtIHIqc2luKGkqYWxmYSthbGZhMCkNCiAgICAgIA0KICAgICAgeCA8LSBhcHBlbmQoeCwgZXgpDQogICAgICB5IDwtIGFwcGVuZCh5LCBleSkNCg0KICAgICAgI1B1bnRvcyBpbnRlcm5vcw0KICAgICAgaXggPC0gcmludCpjb3MoKGkrMS8yKSphbGZhK2FsZmEwKSAjQ2FsY3VsYSBsYSBwb3NpY2lvbiBkZSBsb3MgcHVudG9zIGludGVybm9zDQogICAgICBpeSA8LSByaW50KnNpbigoaSsxLzIpKmFsZmErYWxmYTApDQogICAgICANCiAgICAgIHggPC0gYXBwZW5kKHgsIGl4KQ0KICAgICAgeSA8LSBhcHBlbmQoeSwgaXkpDQogICAgfQ0KDQogIH0gZWxzZSB7DQogICAgcHJpbnQoIkVSUk9SOiBObywgbm8sIG5vLiBMYXMgZXN0cmVsbGFzIHRpZW5lbiB0cmVzIG8gbWFzIHB1bnRvcyIpDQogIH0NCiAgZGZFc3QgPC0gZGF0YS5mcmFtZSgNCiAgICB4LA0KICAgIHksDQogICAgY29sb3IgPSByZXAoZmlsbCwgbGVuZ3RoKHgpKQ0KICAgICkNCn0NCg0KZGlidWphckVzdHJlbGxhIDwtIGZ1bmN0aW9uKG4sIHI9MSwgckludFBjdD01MCwgYWxmYTA9MCwgZmlsbD0iYmx1ZSIpIHsNCiAgZGZFc3QgPC0gY2FsY3VsYXJFc3RyZWxsYShuLCByLCBySW50UGN0LCBhbGZhMCwgZmlsbCkNCg0KICBkaWJ1am8gPC0gZ2dwbG90KGRmRXN0KSArDQogICAgZ2VvbV9wb2x5Z29uKGFlcyh4PSB4LCB5PXksIGZpbGwgPSBjb2xvcikpDQogICANCiAgZ2dwbG90bHkoZGlidWpvLCB3aWR0aCA9IDYwMCwgaGVpZ2h0ID0gNjAwKSAlPiUNCiAgICBhbmltYXRpb25fb3B0cygxMDAwKQ0KfQ0KDQpkaWJ1amFyRXN0cmVsbGEoNCwgYWxmYTA9NDUsIGZpbGw9My4xKQ0KYGBgDQpgYGB7cn0NCmVzdHJlbGxhMWRmIDwtIGNhbGN1bGFyRXN0cmVsbGEoMTYsIGZpbGw9My4wKQ0KZXN0cmVsbGExeHkgPC0gYygpDQoNCmZvciAoaSBpbiAxOmxlbmd0aChlc3RyZWxsYTFkZiR4KSkgew0KICBlc3RyZWxsYTF4eSA8LSBhcHBlbmQoZXN0cmVsbGExeHksIGFzLm51bWVyaWMoZXN0cmVsbGExZGZbaSwgMToyXSkpICANCn0NCg0KdHJhbnNmb3JtYXJZRGlidWphcihlc3RyZWxsYTF4eSwgdHJhbnNmb3JtYWNpb25lczEpDQpgYGANCg==